Celestin Apprentice 2/Apprentice-Release2.iso/Source Code/Peter Lewis/PNL Libraries/DNR.p

Text File | 1994-08-27 | 6.6 KB | 275 lines | [TEXT/PJMM]

unit DNR;

interface

    uses
        TCPTypes;

    type
        ResultProcPtr = ProcPtr;
{ procedure ResultProc(hip:hostInfoPtr; userdata:ptr); }
        ResultProc2Ptr = ProcPtr;
{ procedure ResultProc2(hmxip:HMXInfoPtr; userdata:ptr); }
        EnumResultProcPtr = ProcPtr;
{ procedure EnumResultProc(cerp:cacheEntryRecordPtr; userdata:ptr); }

    function OpenResolver: OSErr;
    procedure CloseResolver;
    function StrToAddr (host: Str255; var rtnStruct: hostInfo; completion: ResultProcPtr; userdata: Ptr): OSErr;
    procedure AddrToStr (addr: longInt; var s: str255);
    function EnumCache (completion: EnumResultProcPtr; userdata: ptr): OSErr;
    function AddrToName (addr: longInt; var hi: hostInfo; completion: ResultProcPtr; userdata: ptr): OSErr;
    function HInfo (host: Str255; var hi: hmxInfoRec; completion: ResultProc2Ptr; userdata: ptr): OSErr;
    function MXInfo (host: Str255; var mxi: hmxInfoRec; completion: ResultProc2Ptr; userdata: ptr): OSErr;

implementation

    uses
{$IFC undefined THINK_Pascal}
        Resources, Errors, Memory,
{$ENDC}
        Folders;

    var
        code: Handle;

    procedure GetSystemFolder (var vrn: integer; var dirID: longInt);
    begin
        if FindFolder(kOnSystemDisk, kSystemFolderType, false, vrn, dirID) <> noErr then begin
            vrn := 0;
            dirID := 0;
        end;
    end;

    procedure GetCPanelFolder (var vrn: integer; var dirID: longInt);
    begin
        if FindFolder(kOnSystemDisk, kControlPanelFolderType, false, vrn, dirID) <> noErr then begin
            vrn := 0;
            dirID := 0;
        end;
    end;

{ SearchFolderForDNRP is called to search a folder for files that might }
{ contain the 'dnrp' resource }
    function SearchFolderForDNRP (ftype, fcreator: OSType; vrn: integer; dirID: longInt): Handle;
        var
            pb: HParamBlockRec;
            filename: Str63;
            refnum: integer;
            i: integer;
            h: Handle;
            err: OSErr;
    begin
        h := nil;
        i := 1;
        repeat
            pb.ioNamePtr := @filename;
            pb.ioVRefNum := vrn;
            pb.ioDirID := dirID;
            pb.ioFDirIndex := i;
            i := i + 1;
            err := PBHGetFInfoSync(@pb);
            if err = noErr then begin
                if (pb.ioFlFndrInfo.fdType = ftype) & (pb.ioFlFndrInfo.fdCreator = fcreator) then begin
                    SetResLoad(false);
                    refnum := HOpenResFile(vrn, dirID, filename, fsRdPerm);
                    SetResLoad(true);
                    if refnum <> -1 then begin
                        h := Get1IndResource('dnrp', 1);
                        if h <> nil then begin
                            DetachResource(h);
                        end;
                        CloseResFile(refnum);
                    end;
                end;
            end;
        until (err <> noErr) or (h <> nil);
        SearchFolderForDNRP := h;
    end;

    function SearchForDNRP: Handle;
        var
            h: Handle;
            vrn: integer;
            dirID: longInt;
    begin
{ first search Control Panels for MacTCP 1.1 }
        GetCPanelFolder(vrn, dirID);
        h := SearchFolderForDNRP('cdev', 'ztcp', vrn, dirID);

        if h = nil then begin
{ next search System Folder for MacTCP 1.0.x }
            GetSystemFolder(vrn, dirID);
            h := SearchFolderForDNRP('cdev', 'mtcp', vrn, dirID);
        end;

        if h = nil then begin
{ then search Control Panels for MacTCP 1.0.x }
            GetCPanelFolder(vrn, dirID);
            h := SearchFolderForDNRP('cdev', 'mtcp', vrn, dirID);
        end;

        if h = nil then begin
{ finally, look in any open resource file }
            h := Get1IndResource('dnrp', 1);
            if h <> nil then begin
                DetachResource(h);
            end;
        end;

        SearchForDNRP := h;
    end;

    function CallOpenResolver (code: ptr): OSErr;
    inline
        $205F, $42A7, $4878, $0001, $4E90, $504F, $3E80;

    function OpenResolver: OSErr;
        var
            err: OSErr;
    begin
        code := SearchForDNRP;
        if code = nil then begin
            err := resNotFound;
        end
        else begin
            HLock(code);
            err := CallOpenResolver(code^);
            if err <> noErr then begin
                DisposeHandle(code);
                code := nil;
            end;
        end;
        OpenResolver := err;
    end;

    procedure CallCloseResolver (code: ptr);
    inline
        $205F, $4878, $0002, $4E90, $584F;

    procedure CloseResolver;
    begin
        if code <> nil then begin
            CallCloseResolver(code^);
            DisposeHandle(code);
        end;
    end;

    procedure P2C (var name: string);
        var
            len: integer;
    begin
        len := length(name);
        BlockMove(@name[1], @name, len);
        name[len] := chr(0);
    end;

    function CallStrToAddr (userdata: ptr; completion: ProcPtr; var rtnStruct: hostInfo; cname: ptr; code: ptr): OSErr;
    inline
        $205F, $4878, $0003, $4E90, $4FEF, $0014, $3E80;

    function StrToAddr (host: Str255; var rtnStruct: hostInfo; completion: ResultProcPtr; userdata: Ptr): OSErr;
        var
            err: OSErr;
            len: integer;
    begin
        if code = nil then begin
            err := notOpenErr;
        end
        else begin
            P2C(host);
            err := CallStrToAddr(userdata, completion, rtnStruct, @host, code^);
        end;
        StrToAddr := err;
    end;

    procedure CallAddrToStr (cstr: ptr; addr: longInt; code: ptr);
    inline
        $205F, $4878, $0004, $4E90, $4FEF, $000C;

    procedure AddrToStr (addr: longInt; var s: str255);
        var
            len: integer;
    begin
        if code <> nil then begin
            CallAddrToStr(@s, addr, code^);
            len := 0;
            while (s[len] <> chr(0)) & (len < 255) do begin
                len := len + 1;
            end;
            BlockMove(@s, @s[1], len);
            s[0] := chr(len);
        end;
    end;

    function CallEnumCache (userdata: ptr; completion: ProcPtr; code: ptr): OSErr;
    inline
        $205F, $4878, $0005, $4E90, $4FEF, $000C, $3E80;

    function EnumCache (completion: EnumResultProcPtr; userdata: ptr): OSErr;
        var
            err: OSErr;
    begin
        if code = nil then begin
            err := notOpenErr;
        end
        else begin
            err := CallEnumCache(userdata, completion, code^);
        end;
        EnumCache := err;
    end;

    function CallAddrToName (userdata: ptr; completion: ProcPtr; var hi: hostInfo; addr: longInt; code: ptr): OSErr;
    inline
        $205F, $4878, $0006, $4E90, $4FEF, $0014, $3E80;

    function AddrToName (addr: longInt; var hi: hostInfo; completion: ResultProcPtr; userdata: ptr): OSErr;
        var
            err: OSErr;
    begin
        if code = nil then begin
            err := notOpenErr;
        end
        else begin
            err := CallAddrToName(userdata, completion, hi, addr, code^);
        end;
        AddrToName := err;
    end;

    function CallHInfo (userdata: ptr; completion: ProcPtr; var hi: hmxInfoRec; name: ptr; code: ptr): OSErr;
    inline
        $205F, $4878, $0007, $4E90, $4FEF, $0014, $3E80;

    function HInfo (host: Str255; var hi: hmxInfoRec; completion: ResultProc2Ptr; userdata: ptr): OSErr;
        var
            err: OSErr;
    begin
        if code = nil then begin
            err := notOpenErr;
        end
        else begin
            P2C(host);
            err := CallHInfo(userdata, completion, hi, @host, code^);
        end;
        HInfo := err;
    end;

    function CallMXInfo (userdata: ptr; completion: ProcPtr; var hi: hmxInfoRec; name: ptr; code: ptr): OSErr;
    inline
        $205F, $4878, $0008, $4E90, $4FEF, $0014, $3E80;

    function MXInfo (host: Str255; var mxi: hmxInfoRec; completion: ResultProc2Ptr; userdata: ptr): OSErr;
        var
            err: OSErr;
    begin
        if code = nil then begin
            err := notOpenErr;
        end
        else begin
            P2C(host);
            err := CallMXInfo(userdata, completion, mxi, @host, code^);
        end;
        MXInfo := err;
    end;

end.